﻿#VisualFreeBasic_Form#  Version=5.6.2
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW, CS_HREDRAW, CS_DBLCLKS
ClassName=
WinStyle=WS_CAPTION,WS_SYSMENU,WS_CLIPSIBLINGS,WS_CLIPCHILDREN,WS_VISIBLE,WS_EX_WINDOWEDGE,WS_EX_CONTROLPARENT,WS_EX_TOPMOST,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_POPUP,WS_SIZEBOX
Style=3 - 常规窗口
Icon=time.ico
Caption=勇芳自动校时 1.1（误差±0.5秒）
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=295
Height=239
TopMost=False
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
Shadow=0 - 无阴影
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Label]
Name=Label1
Index=-1
Style=0 - 无边框
Caption=标准的网络时间：
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,15
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=18
Top=127
Width=305
Height=17
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label2
Index=-1
Style=0 - 无边框
Caption=现在的电脑时间：
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,15
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=18
Top=148
Width=305
Height=17
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[CheckBox]
Name=Check1
Index=-1
Style=0 - 标准
Caption=每次开电脑自动校正
TextAlign=3 - 中左对齐
Alignment=0 - 文本在左边
Value=0 - 未选择
Multiline=True
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,15
Font=微软雅黑,9,0
Left=16
Top=173
Width=132
Height=22
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Button]
Name=Command1
Index=-1
Caption=立即校正
TextAlign=1 - 居中
Ico=
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=206
Top=175
Width=65
Height=26
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Timer]
Name=Timer1
Index=-1
Interval=1000
Enabled=True
Left=1
Top=107
Tag=

[Picture]
Name=Picture1
Index=0
Style=0 - 无边框
Enabled=True
Visible=True
Left=21
Top=3
Width=115
Height=115
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Picture]
Name=Picture1
Index=1
Style=0 - 无边框
Enabled=True
Visible=True
Left=163
Top=5
Width=115
Height=115
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False


[AllCode]

#include Once "win/winsock2.bi"
Dim Shared IntTime As Double, ca As Double
'--------------------------------------------------------------------------------
Sub Form1_WM_Create(hWndForm As hWnd,UserData As Integer)  '完成创建窗口及所有的控件后，此时窗口还未显示。注：自定义消息里 WM_Create 此时还未创建控件和初始赋值。

  FORM1_TIMER1_WM_TIMER 0, 0
  Threaddetach ThreadCreate(@加载, 0) '多线程处理，避免卡顿

End Sub
                      
'--------------------------------------------------------------------------
Sub 加载(aa As Long) '
  If FF_GetRegistryString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "勇芳_自动校时", "") = App.Path & App.EXEName & " 1" Then
       Check1.Value=1
  End If
  
  IntTime = GetInternetTime
  If IntTime > 0 Then
      'FF_Control_Enable HWND_FORM1_COMMAND1  '函数和控件都可以，一样
      Me.Command1.Enabled = True
      IntTime = DateAdd("h", 8, IntTime)
      'Print Format(IntTime, "yyyy-mm-dd hh:mm:ss")
      ca = IntTime - Now
  End If
End Sub

'--------------------------------------------------------------------------
Function GetInternetTime() As Double  '获取网络时间,失败=0
   Dim www(2) As String = {"https://www.baidu.com/", "https://www.qq.com/", "http://www.jd.com/"}
   Dim i As Long, bb As String, ss() As String
   For i = 0 To 2
      bb = GetSocket(www(i))
      If Len(bb) > 0 Then
         bb = UCase(bb)
         vbSplit bb, " ", ss()
         'Print UBound(ss),bb
         If UBound(ss) = 4 Then
            If ss(4) = "GMT" Then
               'Print ss(1)
               Select Case ss(1)
                  Case "JAN" : ss(1) = "1"
                  Case "FEB" : ss(1) = "2"
                  Case "MAR" : ss(1) = "3"
                  Case "APR" : ss(1) = "4"
                  Case "MAY" : ss(1) = "5"
                  Case "JUN" : ss(1) = "6"
                  Case "JUL" : ss(1) = "7"
                  Case "AUG" : ss(1) = "8"
                  Case "SEP" : ss(1) = "9"
                  Case "OCT" : ss(1) = "10"
                  Case "NOV" : ss(1) = "11"
                  Case "DEC" : ss(1) = "12"
               End Select
               'Print ValInt(ss(2)),ValInt(ss(1)),ValInt(ss(0))
               Function = DateSerial(ValInt(ss(2)), ValInt(ss(1)), ValInt(ss(0))) + TimeValue(ss(3))
               Exit For
            End If
         End If
         
      End If
   Next
   
End Function
'--------------------------------------------------------------------------
Function GetSocket(www As String) As String  '联网,获取时间
   Dim As String hostname, path, sendBuffer
   Dim duiko As UShort 
   Dim sa As sockaddr_in
   Dim bytes As Integer
   Dim ip As UInteger
   Dim s As SOCKET
   'Print "初始化WinSock"
   Dim wsaData As WSAData
   If WSAStartup(MAKEWORD(1, 1), @wsaData) Then Return ""
   'Print "检查网址"
   URL_FenLiYuMinLuJing www, hostname, path, duiko
   
   If (Len(hostname) = 0) Then
      WSACleanup
      Return ""
   End If
   ip = resolveHost(hostname)
   If (ip = 0) Then
      WSACleanup : Return ""
   End If
   s = opensocket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
   If (s = 0) Then
      WSACleanup : Return ""
   End If
   'Print "duiko=" & duiko
   duiko = 80
   sa.sin_port = htons(duiko)
   sa.sin_family = AF_INET
   sa.sin_addr.S_addr = ip
   'Print ip
   If (connect(s, Cast(PSOCKADDR, @sa), SizeOf(sa)) = SOCKET_ERROR) Then
      closesocket(s) : WSACleanup : Return ""
   End If
   sendBuffer = "GET /" + path + " HTTP/1.0" + Chr(13, 10) + _
      "Host: " + hostname + Chr(13, 10) + _
      "Connection: close" + Chr(13, 10) + _
      "User-Agent: GetHTTP 0.0" + Chr(13, 10) + _
      Chr(13, 10)
   'Print sendBuffer
   If (send(s, sendBuffer, Len(sendBuffer), 0) = SOCKET_ERROR) Then
      closesocket(s) : WSACleanup : Return ""
   End If
   Dim by(999) As Byte
   
   'Do
   'bytes = recv( s, @by(0), 4096, 0 )
   'If( bytes <= 0 ) Then
   'Exit Do
   'End If
   'sendBuffer=String(bytes,0)
   'memcpy SAdd(sendBuffer),@by(0),bytes
   'Print sendBuffer
   '
   'Loop
   
   bytes = recv(s, @by(0), 1000, 0)
   shutdown(s, 2) '关闭socket
   closesocket(s) '关闭socket
   WSACleanup '释放
   'Print "释放",bytes
   
   If bytes > 0 Then
      Dim ff As Long
      sendBuffer = String(bytes, 0)
      memcpy SAdd(sendBuffer), @by(0), bytes
      
      ff = InStr(sendBuffer, "Date:")
      If ff > 0 Then
         Print www
         sendBuffer = Mid(sendBuffer, ff + 6)
         ff = InStr(sendBuffer, vbCrLf)
         If ff > 0 Then sendBuffer = Left(sendBuffer, ff -1)
         ff = InStr(sendBuffer, ",")
         If ff > 0 Then
            sendBuffer = Trim(Mid(sendBuffer, ff + 1))
            
            Return sendBuffer
         End If
      End If
   End If
   
   
   
End Function


'--------------------------------------------------------------------------------
Sub Form1_Command1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击

  SetDate Format(Now + ca, "mm/dd/yyyy")
  SetTime  Format(Now + ca, "hh:mm:ss")
  Threaddetach ThreadCreate(@加载, 0)
  Command1.Enabled=False 
  ca = 0

End Sub


'--------------------------------------------------------------------------------
Sub Form1_Timer1_WM_Timer(hWndForm As hWnd, wTimerID As Long)  '定时器

  If IntTime = 0 Then
     Label1.Caption= "标准的网络时间：获取中"
     
  Else
      Label1.Caption= "标准的网络时间：" & Format(Now + ca, "yyyy-mm-dd hh:mm:ss")
  End If
  Label2.Caption= "现在的电脑时间：" & NowString
  Picture1(0).Refresh
  Picture1(1).Refresh
End Sub


'--------------------------------------------------------------------------------
Sub Form1_Check1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击

  If FF_Control_GetCheck(hWndControl) Then
      If FF_SetRegistryString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "勇芳_自动校时", App.Path & App.EXEName & " 1") = 0 Then
         Check1.Value= False 
          MessageBox(hWndForm, "增加开机启动失败" & Chr(13, 10) & "如果杀毒软件拦截，请允许通过" & Chr(13, 10) & _
              "如果是WIN7或者以上系统，请用" & Chr(13, 10) & _
              "管理员方式打开本软件后，再设置。"  & Chr(13, 10) & "正常使用软件时不可以用管理员方式打开", "勇芳_自动校时", _
              MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
          
      End If
  Else
      FF_DeleteRegistryKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "勇芳_自动校时")
      If FF_GetRegistryString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "勇芳_自动校时", "") = App.Path & App.EXEName & " 1" Then
          Check1.Value=True 
          MessageBox(hWndForm, "清除开机启动失败" & Chr(13, 10) & "如果杀毒软件拦截，请允许通过" & Chr(13, 10) & _
              "如果是WIN7或者以上系统，请用" & Chr(13, 10) & _
              "管理员方式打开本软件后，再设置。" & Chr(13, 10) & "正常使用软件时不可以用管理员方式打开", "勇芳_自动校时", _
              MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      End If
  End If

End Sub

#define pi 3.1415926

'--------------------------------------------------------------------------------
Function Form1_Picture1_WM_Paint(ControlIndex as Long , hWndForm As hWnd, hWndControl As hWnd) As LResult  '重绘，系统通知控件需要重新绘画。

  
  Dim As Long w, h, x, y, a, ss, mm, hh, x1, y1, x2, y2, rr, i
  Dim aa As String, Nn As Double
  Dim gg As yGDI = yGDI(hWndControl, GetSysColor(COLOR_BTNFACE), True)
  
  gg.GpPen 2, &HFF000000
  gg.GpBrush 0
  gg.GpDrawEllipse 2, 2, 110, 110
  x = 57 : y = 57 '圆心
  '画格子
  For i = 0 To 11
      rr = 55
      y1 = y + rr *Sin((i -3) * (30 *pi / 180))
      x1 = x + rr *Cos((i -3) * (30 *pi / 180))
      rr = 50
      y2 = y + rr *Sin((i -3) * (30 *pi / 180))
      x2 = x + rr *Cos((i -3) * (30 *pi / 180))
      gg.gpDrawLine x1, y1, x2, y2
  Next
  '画格子
  gg.GpPen 1, &HFF000000
  For i = 0 To 59
      rr = 55
      y1 = y + rr *Sin(i * 6 * (pi / 180))
      x1 = x + rr *Cos(i * 6 * (pi / 180))
      rr = 52
      y2 = y + rr *Sin(i * 6 * (pi / 180))
      x2 = x + rr *Cos(i * 6 * (pi / 180))
      gg.gpDrawLine x1, y1, x2, y2
  Next
  
  If ControlIndex = 0 Then nn = Now Else nn = Now + ca
  ss = Second(nn) : mm = Minute(nn) : hh = Hour(nn)
  
  '画时针
  rr = 40
  y2 = y + rr *Sin((hh * 30 + mm / 2 -90) * (pi / 180))
  x2 = x + rr *Cos((hh * 30 + mm / 2 -90) * (pi / 180))
  gg.gpPen 3, &HFFFF3FC0
  gg.gpDrawLine x, y, x2, y2
  
  '画分针
  rr = 50
  y2 = y + rr *Sin((mm * 6 -90) * (pi / 180))
  x2 = x + rr *Cos((mm * 6 -90) * (pi / 180))
  gg.gpPen 1, &HFF1FE080
  gg.gpDrawLine x, y, x2, y2
  
  
  '画秒针
  rr = 50
  y2 = y + rr *Sin((ss * 6 -90) * (pi / 180))
  x2 = x + rr *Cos((ss * 6 -90) * (pi / 180))
  rr = 5
  ss -= 15 : If ss < 0 Then ss += 60
  y1 = y + rr *Sin((ss * 6 -90) * (pi / 180))
  x1 = x + rr *Cos((ss * 6 -90) * (pi / 180))
  gg.gpPen 1, GDIP_ARGB(255, 0, 0, &HFF)
  gg.gpDrawLine x1, y1, x2, y2
  rr = 5
  y2 = y + rr *Sin((ss * 6 -90) * (pi / 180))
  x2 = x + rr *Cos((ss * 6 -90) * (pi / 180))
  rr = 15
  ss -= 15 : If ss < 0 Then ss += 60
  y1 = y + rr *Sin((ss * 6 -90) * (pi / 180))
  x1 = x + rr *Cos((ss * 6 -90) * (pi / 180))
  gg.gpDrawLine x1, y1, x2, y2
  rr = 15
  y2 = y + rr *Sin((ss * 6 -90) * (pi / 180))
  x2 = x + rr *Cos((ss * 6 -90) * (pi / 180))
  rr = 5
  ss -= 15 : If ss < 0 Then ss += 60
  y1 = y + rr *Sin((ss * 6 -90) * (pi / 180))
  x1 = x + rr *Cos((ss * 6 -90) * (pi / 180))
  gg.gpDrawLine x1, y1, x2, y2
  rr = 5
  y2 = y + rr *Sin((ss * 6 -90) * (pi / 180))
  x2 = x + rr *Cos((ss * 6 -90) * (pi / 180))
  rr = 50
  ss -= 15 : If ss < 0 Then ss += 60
  y1 = y + rr *Sin((ss * 6 -90) * (pi / 180))
  x1 = x + rr *Cos((ss * 6 -90) * (pi / 180))
  gg.gpDrawLine x1, y1, x2, y2
  
  Function = True
  
End Function

